home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6 / Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso / 026a / atbbsdbf.zip / PORTLIST.PRG < prev    next >
Text File  |  1990-12-14  |  8KB  |  291 lines
  1. SET TALK OFF
  2. SET ECHO OFF
  3. SET SAFETY OFF
  4. CLEAR
  5.  
  6. SELECT 1
  7.    USE ATBBS ORDER LOCATION
  8. SELECT 2
  9.    USE TEMPATBB
  10.    ZAP
  11. SELECT 3
  12.    USE READFILE
  13.    ZAP
  14.  
  15.    *----- Import the data
  16.  
  17.    ? "Importing file list from 'FILES.'..."
  18.    APPEND FROM FILES. TYPE SDF
  19.    ? "Importing complete..."
  20.    DELAY = INKEY(3)
  21.    CLEAR
  22.  
  23.    *----- Mark all blank records and all column heading records
  24.    *----- for deletion and then delete them
  25.  
  26.    ? "Beginning first pass deletion..."
  27.    ? "Marking blank records for deletion..."
  28.    DELETE ALL FOR LEN(TRIM(FILE_NAME)) = 0
  29.    ? "Marking 'First Column Heading' records for deletion..."
  30.    DELETE ALL FOR RTRIM(LTRIM(FILE_NAME)) + RTRIM(LTRIM(BYTES)) = "FileBytes"
  31.    ? "Marking 'Second Column Heading' records for deletion..."
  32.    DELETE ALL FOR RTRIM(LTRIM(FILE_NAME)) = "----"
  33.    ? "Marking records for deletion 'first pass' complete..."
  34.    ? "Removing records marked for deletion..."
  35.    PACK
  36.    ? "Removal complete..."
  37.    DELAY = INKEY(3)
  38.    CLEAR
  39.  
  40.  
  41.    *----- Check for "LATEST ADDITIONS" section in file.
  42.    *----- If it was found then delete the section heading and
  43.    *----- save the first record number after the heading. 
  44.    *----- Pack the file and calculate the position of the
  45.    *----- first record in the "LATEST ADDITIONS" section.
  46.  
  47.    ? "Beginning second pass deletion..."
  48.    LOCATE FOR FILE_NAME = "LATEST ADDITIONS"
  49.    IF FOUND()
  50.       DELETE NEXT 3
  51.       STORE RECNO() + 1 TO MNEWLIST
  52.       ? "Removing records marked for deletion..."
  53.       PACK
  54.       ? "Removal complete..."
  55.       STORE MNEWLIST - RECCOUNT() TO MNEWLIST
  56.       STORE RECCOUNT() - MNEWLIST TO MNEWLIST
  57.    ELSE
  58.       ? "Second pass complete..."
  59.       STORE RECCOUNT() TO MNEWLIST
  60.    ENDIF
  61.  
  62.    DELAY = INKEY(3)   
  63.    CLEAR
  64.  
  65.    *----- Copy all records from the READFILE.DBF to the TEMPATBB.DBF
  66.    *----- and add the library location of the file to the new record.
  67.  
  68.    SET EXACT ON
  69.    GO TOP
  70.    ?
  71.    ? "Copying records and appending Library name to record..."
  72.    ?
  73.    ?
  74.    DO WHILE .T.
  75.  
  76.       *----- Displays pretties...
  77.  
  78.       IF MOD(RECNO(),25) = 0
  79.          ?? "*"
  80.       ENDIF
  81.       IF MOD(RECNO(),500) = 0
  82.          ?
  83.       ENDIF
  84.  
  85.       *----- If current record is the beginning of "LATEST ADDITIONS" 
  86.       *----- section then exit the loop and continue with the program.
  87.  
  88.       IF RECNO() = MNEWLIST + 1 .OR. EOF()
  89.          EXIT
  90.       ENDIF
  91.  
  92.       *----- Determine if the current record is a file listing 
  93.       *----- or a LIBRARY header.  If it is a LIBRARY header then 
  94.       *----- get the library name from the header otherwise copy 
  95.       *----- this record to the TEMPATBB.DBF file.
  96.  
  97.       IF FILE_NAME = 'FILE DIRECTORY OF'
  98.          MLIB = GETLIB()
  99.       ELSE
  100.          IF NOCOPY(mlib) 
  101.             SKIP
  102.             LOOP
  103.          ENDIF         
  104.          SELECT 2
  105.          APPEND BLANK
  106.          SELECT 3
  107.          REPLACE B->LIBRARY    WITH MLIB
  108.          REPLACE B->FILE       WITH LTRIM(FILE_NAME)
  109.          REPLACE B->BYTES      WITH SPACE(8-LEN(RTRIM(LTRIM(BYTES)))) + RTRIM(LTRIM(BYTES))
  110.          REPLACE B->SOURCE     WITH LTRIM(SOURCE)
  111.          REPLACE B->DESCRIP    WITH LTRIM(DESCRIP)
  112.          REPLACE B->NEW        WITH .T.
  113.          REPLACE B->DOWNLOADED WITH .F.
  114.       ENDIF
  115.       SKIP        
  116.    ENDDO
  117.  
  118.    *----- This loop will copy the "LATEST ADDITIONS" section 
  119.    *----- to the TEMPATBB.DBF.  This is required because the 
  120.    *----- "LATEST ADDITIONS" section is formated a bit 
  121.    *----- different than the rest of the database.
  122.  
  123.    DO WHILE .NOT. EOF()
  124.       MSTR  = FILE_NAME + BYTES + SOURCE + DESCRIP
  125.       IF NOCOPY(RTRIM(LTRIM(FIND1ST())))
  126.          SKIP
  127.          LOOP
  128.       ENDIF
  129.  
  130.       SELECT 2
  131.          APPEND BLANK
  132.          REPLACE LIBRARY    WITH FIND1ST()
  133.          MSTR  = KILL1ST()
  134.          REPLACE FILE       WITH FIND1ST()
  135.          MSTR  = KILL1ST()
  136.          REPLACE BYTES      WITH FIND1ST()
  137.          REPLACE BYTES      WITH SPACE(8-LEN(RTRIM(LTRIM(BYTES)))) + RTRIM(LTRIM(BYTES))
  138.          MSTR  = KILL1ST()
  139.          REPLACE SOURCE     WITH FIND1ST()
  140.          MSTR  = KILL1ST()
  141.          REPLACE DESCRIP    WITH MSTR
  142.          REPLACE NEW        WITH .T.
  143.          REPLACE DOWNLOADED WITH .F.
  144.       SELECT 3
  145.          SKIP
  146.    ENDDO
  147.  
  148.    ?
  149.    ?
  150.    ? "Copying complete..."
  151.    DELAY = INKEY(3)
  152.  
  153.    
  154.    *----- We are finished with the READFILE.DBF.  Now lets work 
  155.    *----- on the TEMPATTB.DBF and copy all new records (those that 
  156.    *----- do not already exist) into the ATBBS.DBF
  157.  
  158.    SELECT 2
  159.    CLEAR
  160.    
  161.    *----- First, let's remove all occurences of the 
  162.    *----- 'FILES.' and 'INDEX.' entries.  These are 
  163.    *----- in every library and we really don't need them. 
  164.    *----- At least I don't think we do.
  165.  
  166.    ? "Cleaning up database..."   
  167.    DELETE ALL FOR TRIM(FILE) = 'FILES.' .OR. TRIM(FILE) = 'INDEX.'
  168.    PACK
  169.    ? "Clean up is complete..."
  170.    DELAY = INKEY(3)
  171.    CLEAR
  172.  
  173.    *----- Locate all records that are in both database and change the
  174.    *----- 'NEW' field to reflect this finding.
  175.  
  176.    ? "Locating and marking duplicate records..."
  177.    ?   
  178.    ?
  179.    SET ORDER TO LOCATION
  180.    SET RELATION TO TRIM(LIBRARY) + TRIM(FILE) INTO ATBBS
  181.    SCAN
  182.       IF MOD(RECNO(),25) = 0
  183.          ?? "*"
  184.       ENDIF
  185.       IF MOD(RECNO(),500) = 0
  186.          ?
  187.       ENDIF
  188.       IF ATBBS->LIBRARY + ATBBS->FILE = LIBRARY + FILE
  189.          REPLACE NEW WITH .F.
  190.       ENDIF
  191.    ENDSCAN
  192.    
  193.    ? "Locating and marking complete..."
  194.    DELAY = INKEY(3)
  195.    CLEAR
  196.  
  197.    *----- Copy all the new records from the TEMPATBB.DBF into the ATBBS.DBF
  198.  
  199.    ? "Copying new records..."
  200.    SET RELATION TO
  201.    USE
  202.    SELECT 1
  203.    APPEND FROM TEMPATBB FOR NEW
  204.    
  205.    ? "Processing of records complete..."
  206.    DELAY = INKEY(3)
  207.    CLEAR
  208.  
  209.    *-----Print routine 
  210.  
  211.    MANSWER = [ ]
  212.    ? 'Do you want a print out of all NEW files   [Y/N]'
  213.    DO WHILE .NOT. MANSWER $ [YN]
  214.       @ 1,53 GET MANSWER PICTURE [!]
  215.       READ
  216.    ENDDO
  217.  
  218.    IF MANSWER = [Y]
  219.       CLEAR
  220.       ? "Printing report..."
  221.       SET CONSOLE OFF
  222.       MPJECT   = _PEJECT
  223.       MPLENGTH = _PLENGTH
  224.       _PEJECT  = [NONE]
  225.       _PLENGTH = 60
  226.       REPORT FORM NEW TO PRINT FOR NEW
  227.       _PEJECT  = MPEJECT
  228.       _PLENGTH = MPLENGTH
  229.       EJECT
  230.       SET CONSOLE ON
  231.       REPLACE ALL NEW WITH .F.
  232.    ENDIF
  233.  
  234.    CLOSE ALL
  235.    CLEAR
  236. RETURN
  237.  
  238. *-----This function will return the Library name from the current record.
  239.  
  240. FUNCTION GETLIB
  241.    MSTR = FILE_NAME + BYTES + SOURCE + DESCRIP
  242.    MSTR = SUBSTR(MSTR,AT("LIB",MSTR))
  243.    MSTR = SUBSTR(MSTR,AT(" ",MSTR)+1)
  244. RETURN TRIM(SUBSTR(MSTR,1,AT(" ",MSTR)))
  245.  
  246.  
  247. *-----This function will return all characters up to and 
  248. *-----including the first space.
  249.  
  250. FUNCTION FIND1ST
  251. RETURN SUBSTR(MSTR,1,AT(" ",MSTR))
  252.  
  253. *-----This function will return a partial copy of the string 
  254. *-----sent.  The returned value will exclude the first set of 
  255. *-----characters (all characters up to the first space) and all
  256. *-----spaces up to the first character of the next set of characters.
  257.  
  258. FUNCTION KILL1ST
  259. RETURN LTRIM(SUBSTR(MSTR,AT(" ",MSTR)))
  260.  
  261.  
  262. *-----This function will return .T. if the file is not to be copied.
  263. *-----You will need to fill in the CASE statements for the areas that 
  264. *-----define the files you do not want copied.  I have included a sample.
  265. *-----DEFAULT is all files WILL BE COPIED.
  266.  
  267. FUNCTION NOCOPY
  268. parameters LIB_NAME
  269.  
  270.    WILLCOPY = .F.
  271.    LIBN = TRIM(LIB_NAME)
  272.  
  273.  
  274.    DO CASE
  275. *----- To specify files to EXCLUDE use these examples:
  276.  
  277. *      CASE LIB-NAME = "FW2"                && This will cause all files in the
  278. *         RETURN .T.                        && 'FW2' library to be skipped.
  279. *       CASE SUBSTR(LIB_NAME,1,1) = 'F'     && All files in any library starting
  280. *         RETURN .T.                        && with 'F' will be skipped.
  281.  
  282. *----- To specify files to INCLUDE use these examples:
  283.  
  284. *      CASE LIB_NAME = "FW2"
  285. *         RETURN .F.
  286. *      CASE SUBSTR(LIB_NAME,1,1) = 'F'
  287. *         RETURN .F.
  288.  
  289.    ENDCASE
  290. RETURN WILLCOPY
  291.